ci.f.em <- confint(ate.f.em[[i]])
print(b.f.em[i])
lb.f.em <- ci.f.em[2,1]
ub.f.em <- ci.f.em[2,2]
cis.f.em[i,] <- cbind(lb.f.em,ub.f.em)
}
for (i in 1:length(future))
{
b.f.c[i] <- ate.f.c[[i]]$coefficients[2]
print(ate.f.c[[i]]$coefficients[2])
ci.f.c <- confint(ate.f.c[[i]])
#print(ci)
lb.f.c <- ci.f.c[2,1]
ub.f.c <- ci.f.c[2,2]
cis.f.c[i,] <- cbind(lb.f.c,ub.f.c)
}
for (i in 1:length(future))
{
b.f.nc[i] <- ate.f.nc[[i]]$coefficients[2]
ci.f.nc <- confint(ate.f.nc[[i]])
print(b.f.nc[i])
lb.f.nc <- ci.f.nc[2,1]
ub.f.nc <- ci.f.nc[2,2]
cis.f.nc[i,] <- cbind(lb.f.nc,ub.f.nc)
}
### Specify y-labs and labels: future preferences
y.lab.f <- seq(from = 1, to=length(future),by=1)
vnames.f <-c(remain = "Remain Part\n of the UK",
independence = "Become an\n Independent State",
unification = "Unify with the\n Rest of Ireland")
### Jitter to position coefficients
jitter.f.c <-  -0.15
jitter.f.nc <-  -0.30
### Set margins
par(mfrow=c(1,1), mar=c(5, 4, 0, 3), oma=c(0.5, 3.5,0.5,0.2), mgp=c(2,0.8,0))
### PLOT 3
plot(b.f.c, y.lab.f, type="n", ylab ="", xlab = "", yaxt="n",
xlim = c(-0.4,0.4), ylim = c(0.5,3.5),
cex.axis=0.75)
axis(2, at=y.lab.f, labels=vnames.f, las = 2, cex.axis=0.75)
mtext("Difference in Means",side=1,line=2,outer=F, cex = 0.85)
#b[CI]s: entropy weights
points(b.f.em, y.lab.f, pch=21, cex=1, lwd=1, col = "black")
segments(cis.f.em[,1], y.lab.f, cis.f.em[,2], y.lab.f, lty=1, cex=1, lwd=1, col = "black")
#b[CI]s: controls
points(b.f.c, y.lab.f+jitter.f.c, pch= 4, cex=1, lwd=1, col = "grey20")
segments(cis.f.c[,1], y.lab.f+jitter.f.c, cis.f.c[,2], y.lab.f+jitter.f.c, lty=2, cex=1, lwd=1, col = "grey20")
#b[CI]s: nothing
points(b.f.nc, y.lab.f+jitter.f.nc, pch= 6, cex=1, lwd=1, col = "grey50")
segments(cis.f.nc[,1], y.lab.f+jitter.f.nc, cis.f.nc[,2], y.lab.f+jitter.f.nc, lty=4, cex=1, lwd=1, col = "grey50")
abline(v=0)
### Settings to print legend to the device region
par(xpd=NA)
### LEGEND ###
legend(x=-0.588, y=-0.25, horiz = T, cex = 0.7,
legend=c("Matching", "Covariates", "No Correction"),
title = "Applied correction for imbalance",
lty = c(1,2,4), col=c("black", "grey20", "grey50"), pch=c(21,4,6))
# Subset the data
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
summary(as.factor(Brexit$referendum))
summary(as.factor(Brexit$referendum2))
#delete respondents interviewed on day of the referendum to control
Brexit.ref <- subset(Brexit, referendum2 != 1)
summary(as.factor(Brexit.ref$referendum))
summary(as.factor(Brexit.ref$referendum2))
# Re-run the exact same code on the subsample
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## Three model specifications
#models with controls or weights (to fix unbalance)
right.side.c <- "~ referendum + age + employment_1 + exposure"
varlabels <- c("Brexit", "Age", "Employed", "Conflict Exposure")
#models without controls
right.side.nc <- "~ referendum"
varlabels.nc <- "Brexit"
#models with entropy matching
W.out.ref <- weightit(referendum ~ age + employment_1 + exposure,
data = Brexit.ref, estimand = "ATT", method = "ebal") #create weights
summary(W.out.ref)
#### Economic and political causes ####
rootcauses <- Cs(cause_1,cause_2,cause_3,cause_4)
ate.rc.em <- vector(length(rootcauses), mode = "list")
names(ate.rc.em) <- rootcauses
for (i in 1:(length(rootcauses))){
modelformula <- paste(rootcauses[i],right.side.nc)
print(modelformula)
ate.rc.em[[rootcauses[i]]] <- eval(substitute(lm(.modelformula, data = Brexit.ref, weights = W.out.ref$w), #use weights
list(.modelformula = modelformula)))
print(summary(ate.rc.em[[rootcauses[i]]])) #print results,
print(confint(ate.rc.em[[rootcauses[i]]])) #including CIs
}
#model with controls
ate.rc.c <- vector(length(rootcauses), mode = "list")
names(ate.rc.c) <- rootcauses
for (i in 1:(length(rootcauses))){
modelformula <- paste(rootcauses[i],right.side.c)
print(modelformula)
ate.rc.c[[rootcauses[i]]] <- eval(substitute(lm(.modelformula, data = Brexit.ref),
list(.modelformula = modelformula)))
print(summary(ate.rc.c[[rootcauses[i]]])) #print results,
print(confint(ate.rc.c[[rootcauses[i]]])) #including CIs
}
#model without controls or matching
ate.rc.nc <- vector(length(rootcauses), mode = "list")
names(ate.rc.nc) <- rootcauses
for (i in 1:(length(rootcauses))){
modelformula <- paste(rootcauses[i],right.side.nc)
print(modelformula)
ate.rc.nc[[rootcauses[i]]] <- eval(substitute(lm(.modelformula, data = Brexit.ref),
list(.modelformula = modelformula)))
print(summary(ate.rc.nc[[rootcauses[i]]])) #print results,
print(confint(ate.rc.nc[[rootcauses[i]]])) #including CIs
}
#### Actor-based causes ####
actorcauses <- Cs(cause_5,cause_6,cause_7,cause_8)
#model with entropy matching
ate.ac.em <- vector(length(actorcauses), mode = "list")
names(ate.ac.em) <- actorcauses
for (i in 1:(length(actorcauses))){
modelformula <- paste(actorcauses[i],right.side.nc)
print(modelformula)
ate.ac.em[[actorcauses[i]]] <- eval(substitute(lm(.modelformula, data = Brexit.ref, weights = W.out.ref$w), #use weights
list(.modelformula = modelformula)))
print(summary(ate.ac.em[[actorcauses[i]]])) #print results,
print(confint(ate.ac.em[[actorcauses[i]]])) #including CIs
}
#model with controls
ate.ac.c <- vector(length(actorcauses), mode = "list")
names(ate.ac.c) <- actorcauses
for (i in 1:(length(actorcauses))){
modelformula <- paste(actorcauses[i],right.side.c)
print(modelformula)
ate.ac.c[[actorcauses[i]]] <- eval(substitute(lm(.modelformula, data = Brexit.ref),
list(.modelformula = modelformula)))
print(summary(ate.ac.c[[actorcauses[i]]])) #print results,
print(confint(ate.ac.c[[actorcauses[i]]])) #including CIs
}
#model without controls
ate.ac.nc <- vector(length(actorcauses), mode = "list")
names(ate.ac.nc) <- actorcauses
for (i in 1:(length(actorcauses))){
modelformula <- paste(actorcauses[i],right.side.nc)
print(modelformula)
ate.ac.nc[[actorcauses[i]]] <- eval(substitute(lm(.modelformula, data = Brexit.ref),
list(.modelformula = modelformula)))
print(summary(ate.ac.nc[[actorcauses[i]]])) #print results,
print(confint(ate.ac.nc[[actorcauses[i]]])) #including CIs
}
####### Figure 1: Preparations ########
### Get b's and ci's for rootcauses
cis.rc.em <- matrix(NA,length(rootcauses),2)
b.rc.em <- matrix(NA,length(rootcauses),1)
cis.rc.c <- matrix(NA,length(rootcauses),2)
b.rc.c <- matrix(NA,length(rootcauses),1)
cis.rc.nc <- matrix(NA,length(rootcauses),2)
b.rc.nc <- matrix(NA,length(rootcauses),1)
for (i in 1:length(rootcauses))
{
b.rc.em[i] <- ate.rc.em[[i]]$coefficients[2]
ci.rc.em <- confint(ate.rc.em[[i]])
print(b.rc.em[i])
lb.rc.em <- ci.rc.em[2,1]
ub.rc.em <- ci.rc.em[2,2]
cis.rc.em[i,] <- cbind(lb.rc.em,ub.rc.em)
}
for (i in 1:length(rootcauses))
{
b.rc.c[i] <- ate.rc.c[[i]]$coefficients[2]
ci.rc.c <- confint(ate.rc.c[[i]])
print(b.rc.c[i])
lb.rc.c <- ci.rc.c[2,1]
ub.rc.c <- ci.rc.c[2,2]
cis.rc.c[i,] <- cbind(lb.rc.c,ub.rc.c)
}
for (i in 1:length(rootcauses))
{
b.rc.nc[i] <- ate.rc.nc[[i]]$coefficients[2]
ci.rc.nc <- confint(ate.rc.nc[[i]])
print(b.rc.nc[i])
lb.rc.nc <- ci.rc.nc[2,1]
ub.rc.nc <- ci.rc.nc[2,2]
cis.rc.nc[i,] <- cbind(lb.rc.nc,ub.rc.nc)
}
### Get b's and ci's for actor causes
cis.ac.em <- matrix(NA,length(actorcauses),2)
b.ac.em <- matrix(NA,length(actorcauses),1)
cis.ac.c <- matrix(NA,length(actorcauses),2)
b.ac.c <- matrix(NA,length(actorcauses),1)
cis.ac.nc <- matrix(NA,length(actorcauses),2)
b.ac.nc <- matrix(NA,length(actorcauses),1)
for (i in 1:length(actorcauses))
{
b.ac.em[i] <- ate.ac.em[[i]]$coefficients[2]
ci.ac.em <- confint(ate.ac.em[[i]])
print(b.ac.em[i])
lb.ac.em <- ci.ac.em[2,1]
ub.ac.em <- ci.ac.em[2,2]
cis.ac.em[i,] <- cbind(lb.ac.em,ub.ac.em)
}
for (i in 1:length(actorcauses))
{
b.ac.c[i] <- ate.ac.c[[i]]$coefficients[2]
ci.ac.c <- confint(ate.ac.c[[i]])
print(b.ac.c[i])
lb.ac.c <- ci.ac.c[2,1]
ub.ac.c <- ci.ac.c[2,2]
cis.ac.c[i,] <- cbind(lb.ac.c,ub.ac.c)
}
for (i in 1:length(actorcauses))
{
b.ac.nc[i] <- ate.ac.nc[[i]]$coefficients[2]
ci.ac.nc <- confint(ate.ac.nc[[i]])
print(b.ac.nc[i])
lb.ac.nc <- ci.ac.nc[2,1]
ub.ac.nc <- ci.ac.nc[2,2]
cis.ac.nc[i,] <- cbind(lb.ac.nc,ub.ac.nc)
}
### Specify y-labs and labels: rootcauses
y.lab <- seq(from = 1, to=length(rootcauses),by=1)
rc.vnames <-c(causes_1 = "Economic inequality\n and poverty",
causes_2 = "Community-based,\n inequality",
causes_3 = "Discrimination\n and repression",
causes_4 = "Lack of Democracy")
### Specify y-labs and labels: actorcauses
y.lab <- seq(from = 1, to=length(actorcauses),by=1)
ac.vnames <-c(causes_5 = "Extremist\n Republicans",
causes_6 = "Extremist\n Loyalists",
causes_7 = "Illegitimate rule\n from Westminster",
causes_8 = "Partition of Ireland")
### Jitter to position coefficients
jitter.c <-  -0.15
jitter.nc <-  -0.30
### Set margins
par(mfrow=c(1,2), mar = c(5, 4, 0, 2), oma = c(0.5, 3.5, 0, 0), mgp=c(2,0.5,0))
### PLOT 1 ###
plot(b.rc.c, y.lab,
type="n",
ylab ="", xlab = "", yaxt="n",
xlim = c(-0.6,0.6), ylim = c(0.5,4.5),
cex.axis=0.75)
axis(2, at=y.lab, labels=rc.vnames, las = 2, cex.axis=0.75)
mtext("Difference in Means",side=1,line=2,outer=F, cex = 0.8)
#b[CI]s: entropy weights
points(b.rc.em, y.lab, pch=21, cex=1, lwd=1, col = "black")
segments(cis.rc.em[,1], y.lab, cis.rc.em[,2], y.lab, lty=1, lwd=1, col = "black")
#b[CI]s: controls
points(b.rc.c, y.lab+jitter.c, pch= 4, cex=1, lwd=1, col = "grey20")
segments(cis.rc.c[,1], y.lab+jitter.c, cis.rc.c[,2], y.lab+jitter.c, lty=2, lwd=1, col = "grey20")
#b[CI]s: nothing
points(b.rc.nc, y.lab+jitter.nc, pch= 6, cex=1, lwd=1, col = "grey50")
segments(cis.rc.nc[,1], y.lab+jitter.nc, cis.rc.nc[,2], y.lab+jitter.nc, lty=4, lwd=1, col = "grey50")
abline(v=0)
### Set margins
par(mar = c(5, 5, 0, 0.5))
### PLOT 2 ###
plot(b.ac.c, y.lab, type="n", ylab ="", xlab = "", yaxt="n", xlim = c(-0.6,0.6), ylim = c(0.5,4.5),
cex.axis=0.75)
axis(2, at=y.lab, labels=ac.vnames, las = 2, cex.axis=0.75)
mtext("Difference in Means",side=1,line=2,outer=F, cex = 0.8)
#b[CI]s: entropy weights
points(b.ac.em, y.lab, pch=21, cex=1, lwd=1, col = "black")
segments(cis.ac.em[,1], y.lab, cis.ac.em[,2], y.lab, lty=1, cex=1, lwd=1, col = "black")
#b[CI]s: controls
points(b.ac.c, y.lab+jitter.c, pch= 4, cex=1, lwd=1, col = "grey20")
segments(cis.ac.c[,1], y.lab+jitter.c, cis.ac.c[,2], y.lab+jitter.c, lty=2, cex=1, lwd=1, col = "grey20")
#b[CI]s: nothing
points(b.ac.nc, y.lab+jitter.nc, pch= 6, cex=1, lwd=1, col = "grey50")
segments(cis.ac.nc[,1], y.lab+jitter.nc, cis.ac.nc[,2], y.lab+jitter.nc, lty=4, cex=1, lwd=1, col = "grey50")
abline(v=0)
### Settings to print legend to the device region
par(xpd=NA)
### LEGEND ###
legend(x=-2.3, y=-0.65, horiz = T, cex = 0.7,
legend=c("Matching", "Covariates", "No Correction"),
title = "Applied correction for imbalance",
lty = c(1,2,4), col=c("black", "grey20", "grey50"), pch=c(21,4,6))
#### Preferences for the Future ####
future <- Cs(remain,independence, unification)
#model with entropy matching
ate.f.em <- vector(length(future), mode = "list")
names(ate.f.em) <- future
for (i in 1:(length(future))){
modelformula <- paste(future[i],right.side.nc)
print(modelformula)
ate.f.em[[future[i]]] <- eval(substitute(lm(.modelformula, data = Brexit.ref, weights = W.out.ref$w), #use weights
list(.modelformula = modelformula)))
print(summary(ate.f.em[[future[i]]]))
}
#model with controls
ate.f.c <- vector(length(future), mode = "list")
names(ate.f.c) <- future
for (i in 1:(length(future))){
modelformula <- paste(future[i],right.side.c)
print(modelformula)
ate.f.c[[future[i]]] <- eval(substitute(lm(.modelformula, data = Brexit.ref),
list(.modelformula = modelformula)))
print(summary(ate.f.c[[future[i]]]))
}
#model without controls
ate.f.nc <- vector(length(future), mode = "list")
names(ate.f.nc) <- future
for (i in 1:(length(future))){
modelformula <- paste(future[i],right.side.nc)
print(modelformula)
ate.f.nc[[future[i]]] <- eval(substitute(lm(.modelformula, data = Brexit.ref),
list(.modelformula = modelformula)))
print(summary(ate.f.nc[[future[i]]]))
}
####### Figure 3: Preparations ########
### Get b's and ci's for preferences for the future
cis.f.em <- matrix(NA,length(future),2)
b.f.em <- matrix(NA,length(future),1)
cis.f.c <- matrix(NA,length(future),2)
b.f.c <- matrix(NA,length(future),1)
cis.f.nc <- matrix(NA,length(future),2)
b.f.nc <- matrix(NA,length(future),1)
for (i in 1:length(future))
{
b.f.em[i] <- ate.f.em[[i]]$coefficients[2]
ci.f.em <- confint(ate.f.em[[i]])
print(b.f.em[i])
lb.f.em <- ci.f.em[2,1]
ub.f.em <- ci.f.em[2,2]
cis.f.em[i,] <- cbind(lb.f.em,ub.f.em)
}
for (i in 1:length(future))
{
b.f.c[i] <- ate.f.c[[i]]$coefficients[2]
print(ate.f.c[[i]]$coefficients[2])
ci.f.c <- confint(ate.f.c[[i]])
#print(ci)
lb.f.c <- ci.f.c[2,1]
ub.f.c <- ci.f.c[2,2]
cis.f.c[i,] <- cbind(lb.f.c,ub.f.c)
}
for (i in 1:length(future))
{
b.f.nc[i] <- ate.f.nc[[i]]$coefficients[2]
ci.f.nc <- confint(ate.f.nc[[i]])
print(b.f.nc[i])
lb.f.nc <- ci.f.nc[2,1]
ub.f.nc <- ci.f.nc[2,2]
cis.f.nc[i,] <- cbind(lb.f.nc,ub.f.nc)
}
### Specify y-labs and labels: future preferences
y.lab.f <- seq(from = 1, to=length(future),by=1)
vnames.f <-c(remain = "Remain Part\n of the UK",
independence = "Become an\n Independent State",
unification = "Unify with the\n Rest of Ireland")
### Jitter to position coefficients
jitter.f.c <-  -0.15
jitter.f.nc <-  -0.30
### Set margins
par(mfrow=c(1,1), mar=c(5, 4, 0, 3), oma=c(0.5, 3.5,0.5,0.2), mgp=c(2,0.8,0))
### PLOT 3
plot(b.f.c, y.lab.f, type="n", ylab ="", xlab = "", yaxt="n",
xlim = c(-0.4,0.4), ylim = c(0.5,3.5),
cex.axis=0.75)
axis(2, at=y.lab.f, labels=vnames.f, las = 2, cex.axis=0.75)
mtext("Difference in Means",side=1,line=2,outer=F, cex = 0.85)
#b[CI]s: entropy weights
points(b.f.em, y.lab.f, pch=21, cex=1, lwd=1, col = "black")
segments(cis.f.em[,1], y.lab.f, cis.f.em[,2], y.lab.f, lty=1, cex=1, lwd=1, col = "black")
#b[CI]s: controls
points(b.f.c, y.lab.f+jitter.f.c, pch= 4, cex=1, lwd=1, col = "grey20")
segments(cis.f.c[,1], y.lab.f+jitter.f.c, cis.f.c[,2], y.lab.f+jitter.f.c, lty=2, cex=1, lwd=1, col = "grey20")
#b[CI]s: nothing
points(b.f.nc, y.lab.f+jitter.f.nc, pch= 6, cex=1, lwd=1, col = "grey50")
segments(cis.f.nc[,1], y.lab.f+jitter.f.nc, cis.f.nc[,2], y.lab.f+jitter.f.nc, lty=4, cex=1, lwd=1, col = "grey50")
abline(v=0)
### Settings to print legend to the device region
par(xpd=NA)
### LEGEND ###
legend(x=-0.588, y=-0.25, horiz = T, cex = 0.7,
legend=c("Matching", "Covariates", "No Correction"),
title = "Applied correction for imbalance",
lty = c(1,2,4), col=c("black", "grey20", "grey50"), pch=c(21,4,6))
cause.8.unify.sens <- medsens(cause.8.unify, rho.by = 0.1, effect.type = "indirect", sims = 1000)
summary(cause.8.unify.sens)
cause.8.remain.sens <- medsens(cause.8.remain, rho.by = 0.1, effect.type = "indirect", sims = 1000)
summary(cause.8.remain.sens)
cause.7.unify.sens <- medsens(cause.7.unify, rho.by = 0.1, effect.type = "indirect", sims = 1000)
summary(cause.7.unify.sens)
cause.7.remain.sens <- medsens(cause.7.remain, rho.by = 0.1, effect.type = "indirect", sims = 1000)
summary(cause.7.remain.sens)
#fit the regression model
meds.unification.7 <- lm(unification ~ cause_1 + cause_2 + cause_3 + cause_4 + cause_5 + cause_7,
data = Brexit)
meds.unification.8 <- lm(unification ~ cause_1 + cause_2 + cause_3 + cause_4 + cause_5 + cause_8,
data = Brexit)
#view the output of the regression model
summary(meds.unification.7)
summary(meds.unification.8)
#calculate the VIF for each predictor variable in the model
vif(meds.unification.7)
vif(meds.unification.8)
#fit the regression model
meds.remain.7 <- lm(remain ~ cause_1 + cause_2 + cause_3 + cause_4 + cause_5 + cause_7,
data = Brexit)
meds.remain.8 <- lm(remain ~ cause_1 + cause_2 + cause_3 + cause_4 + cause_5 + cause_8,
data = Brexit)
#view the output of the regression model
summary(meds.remain.7)
summary(meds.remain.8)
#calculate the VIF for each predictor variable in the model
vif(meds.remain.7)
vif(meds.remain.8)
stargazer(meds.unification.7, meds.unification.8, meds.remain.7, meds.remain.8,
title="Relationship between Mediators and Preferences for the Future of Northern Ireland",
model.numbers = F,
omit.stat = c("ser", "f"),
type='latex',
font.size = 'small',
header=FALSE,
label = "meds",
star.char = c("+", "*", "**", "***"),
star.cutoffs = c(.1, .05, .01, .001),
notes = c("+ p<0.1; * p<0.05; ** p<0.01; *** p<0.001"),
notes.append = F,
notes.align = "l")
# Google Trends in Northern Ireland -----------
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
gt1 <- read.csv(file = "Data/Brexit_GT_NI.csv")
gt_ni <- gt1 %>%
mutate(immigration = Immigration...Northern.Ireland.) %>%
mutate(troubles = Good.Friday.Agreement...Northern.Ireland.+the.Troubles...Northern.Ireland.) %>%
mutate(date = as.Date(Day)) %>%
#select(date, immigration, troubles) %>%
gather(search, share, immigration:troubles) %>%
filter(share > 0)
str(gt_ni)
# plot 1
gt_ni_plot <- ggplot(gt_ni, aes(x=date, y=share, group=search)) +
geom_line(aes(color=search), size=0.5) +
geom_point(aes(color=search))+
geom_vline(xintercept=as.Date("2016-06-23"), linetype=1, size=1,color="#2F7B8E") +
theme(legend.position="right")+
theme_classic() +
theme(plot.title = element_text(size=11),
legend.text = element_text(size = 10, colour = "black"),
axis.text = element_text(size = 10, colour = "black")) +
labs(title = "A. Northern Ireland", x = "", y = "", color = "Search term", linetype = "Search term")+
scale_colour_grey(start = 0.7, end = 0.2,
breaks = c("immigration", "troubles"),
labels = c("Immigration", "The Troubles")) +
scale_x_date(breaks = as.Date(c("2016-04-15", "2016-06-23", "2016-09-01")),
labels = c("April 4", "June 23\n EU Referendum", "Sep 1"))
# Google Trends in Great Britain -----------
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
gt2 <- read.csv(file = "Data/Brexit_GT_England.csv")
gt3 <- read.csv(file = "Data/Brexit_GT_Scotland.csv")
gt4 <- read.csv(file = "Data/Brexit_GT_Wales.csv")
# merge GT dataframes
gt_gb <- merge(gt2, gt3, by="Day")
gt_gb <- merge(gt_gb, gt4, by="Day")
# clean GT data GB
gt_gb <- gt_gb %>%
mutate(immigration = (Immigration...England.+
Immigration...Scotland.+
Immigration...Wales.)/3) %>%
mutate(troubles = ((Good.Friday.Agreement...England.+
Good.Friday.Agreement...Scotland.+
Good.Friday.Agreement...Wales.)/3)+
((the.Troubles...England.+
the.Troubles...Scotland.+
the.Troubles...Wales.)/3)) %>%
mutate(date = as.Date(Day)) %>%
select(date, immigration, troubles) %>%
gather(search, share, immigration:troubles) %>%
filter(share > 0)
str(gt_gb)
# plot 2
gt_gb_plot <- ggplot(gt_gb, aes(x=date, y=share, group=search)) +
geom_line(aes(color=search), size=0.5)+
geom_point(aes(color=search))+
geom_vline(xintercept=as.Date("2016-06-23"), linetype=1, size=1,color="#2F7B8E") +
theme(legend.position="right")+
theme_classic() +
theme(plot.title = element_text(size=11),
legend.text = element_text(size = 10, colour = "black"),
axis.text = element_text(size = 10, colour = "black")) +
labs(title = "B. Great Britain", x = "", y = "", color = "Search term", linetype = "Search term")+
scale_colour_grey(start = 0.7, end = 0.2,
breaks = c("immigration", "troubles"),
labels = c("Immigration", "The Troubles")) +
scale_x_date(breaks = as.Date(c("2016-04-15", "2016-06-23", "2016-09-01")),
labels = c("April 4", "June 23\n EU Referendum", "Sep 1"))
# function to arrange plots with shared legend at the bottom
grid_arrange_shared_legend <- function(...) {
plots <- list(...)
g <- ggplotGrob(plots[[1]] + theme(legend.position="bottom"))$grobs
legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
lheight <- sum(legend$height)
grid.arrange(
do.call(arrangeGrob, lapply(plots, function(x)
x + theme(legend.position="none"))),
legend,
ncol = 1,
heights = unit.c(unit(1, "npc") - lheight, lheight))
}
figure <- grid_arrange_shared_legend(gt_ni_plot, gt_gb_plot, nrow = 2)
annotate_figure(figure,
bottom = text_grob("Data source: Google Trends\nNumbers represent search interest relative to the highest point on the chart for the given region and time.\nA value of 100 is the peak popularity for the term. A value of 50 means that the term is half as popular.\nA score of 0 means there was not enough data for this term.", color = "black",
hjust = 1, x = 1, face = "italic", size = 8))
table1 <- table(Brexit$q603ni)
prop.table(table1)*100
summary(cause.8.unify.sens)
summary(cause.8.remain.sens)
summary(cause.7.unify.sens)
summary(cause.7.remain.sens)
summary(lm(cause_1 ~ referendum, data = Brexit))
381.90*2
